#' @export
.iCall <- function(...) .Call(...)

setClass("Datasource", slots = c(
  pointer = "externalptr",
  datasets = "list"), 
  prototype = list(pointer=NULL)
)

setClass("Dataset", slots = c(
  pointer = "externalptr"), 
  prototype = list(pointer=NULL)
)

setClass("DatasetVector", contains = "Dataset")

setClass("DatasetRaster", contains = "Dataset")

setClass("FieldInfo", slots =c(
  name="character",
  caption = "character",
  default = "character",
  type="character",
  systemField="logical",
  required = "logical",
  maxLength = "integer"
), prototype = list(default=character(), caption=character(), 
                    systemField=FALSE, required=FALSE, maxLength=255L))

.ds.datasets <- function(obj){
  if(is.null(obj)){
    stop("obj must be valid")
  }
  if(class(obj) != "Datasource"){
    stop("obj must be Datasource")
  }
  res <- .iCall("R_Datasource_datasets", obj@pointer, PACKAGE="RSuperMap")
  if(!is.null(res) && is.list(res)){
    dts <- list()
    for(dt in res){
      name <- GetDatasetName(dt)
      dts[[name]] <- dt
    }
    return(dts)
  }
  else{
    warning("getting datasets failure")
    return(NULL)
  }
}

.valid.engine.type <-  c('udb', 'OraclePlus', 'SqlServerPlus')
.valid.dataset.type <-  c('Point', 'Line', 'Region', 'Tabular', 'Grid')

PrintEngineType <- function(){
  print(.valid.engine.type)
}

PrintDatasetType <- function(){
  print(.valid.dataset.type)
}

.dss.class <- setRefClass(Class = "Datasources", 
                  fields = list(datasources = "list"))

.dss.class$methods(list(
  add.datasource = function(alias, ds){
    if(is.null(alias)){
      stop("invalid alias")
    }
    if(is.null(ds)){
      stop("invalid ds")
    }
    if(class(ds) != "Datasource"){
      stop("ds must be Datasource object")
    }
    if(is.datasource.exist(alias)){
      warning("alias is existed in datasources")
      return(FALSE)
    }
    datasources[[alias]] <<- ds
    return(TRUE)
  },
  get.datasource = function(alias){
    if(is.null(alias)){
      stop("invalid alias")
    }
    return(datasources[[alias]])
  },
  set.datasource = function(ds, alias=character()){
    if(is.null(ds)){
      stop("invalid ds")
    }
    if(class(ds) != "Datasource"){
      stop("ds must be Datasource object")
    }
    valid.alias <- character()
    if(is.null(alias) || length(alias) == 0){
      valid.alias <- GetAlias(ds)
    }
    else{
      valid.alias <- alias
    }
    datasources[[valid.alias]] <<- ds
  },
  remove.datasource = function(obj){
    if(is.null(obj)){
      stop("invalid obj")
    }
    if(is.character(obj)){
      datasources[[obj]] <<- NULL
      return(TRUE)
    }
    else if(class(obj) == "Datasource"){
      alias <- GetAlias(obj)
      datasources[[alias]] <<- NULL
      return(TRUE)
    }
    else{
      return(FALSE)
    }
  },
  get.datasources = function(){
    return(datasources)
  },
  is.datasource.exist = function(obj){
    if(is.null(obj)){
      stop("invalid obj")
    }
    if(is.character(obj)){
      aliases <- names(datasources)
      return(length(aliases[(aliases == obj)]) > 0)
    } else {
      return(FALSE)
    }
  },
  close.all.datasources = function(){
    for(ds in datasources){
      CloseDatasource(ds)
    }
    datasources <<- list()
  }
))

.datasources <- .dss.class$new()

#'@export
.IsEngineTypeValid <- function(name){
  if (is.null(name)) {
    stop("name must be valid")
  }
  if (!is.character(name)) {
    stop("name must be character")
  }
  if (length(.valid.engine.type[(.valid.engine.type == name)]) == 1) {
    return(TRUE)
  } else {
    warning("engine type is invalid")
    return(FALSE)
  }
}

#'@export
.IsDatasetTypeValid <- function(name){
  if (is.null(name)) {
    stop("name must be valid")
  }
  if (!is.character(name)) {
    stop("name must be character")
  }
  if (length(.valid.dataset.type[(.valid.dataset.type == name)]) == 1) {
    return(TRUE)
  } else {
    warning("dataset type is invalid")
    return(FALSE)
  }
}

IsDatasourceExist <- function(value) {
  if(is.null(value)){
    stop("value invalid, must be datasource alias ")
  }
  return(.datasources$is.datasource.exist(value))
}

GetDatasource <- function(alias) {
  if(is.null(alias)){
    stop("alias must be valid")
  }
  if(.datasources$is.datasource.exist(alias)){
    return(.datasources$get.datasource(alias))
  } else {
    warning("alias is existed in datasources")
    return(NULL)
  }
}

#' @export
.SetDatasource <- function(alias, ds){
  if(is.null(alias)){
    stop("alias must be valid")
  }
  .datasources$set.datasource(ds, alias)
}

GetDatasources <- function() {
 .datasources$get.datasources() 
}

CloseAllDatasource <- function(){
  .datasources$close.all.datasources()
}

OpenDatasource <- function(server, alias="", engine="udb", database="", driver="", user="", password=""){
  if (is.null(server)) {
    stop("server must be valid")
  }
  if (!is.character(server)) {
    stop("server  must be character")
  }
  if (is.null(alias)) {
    stop("alias must be valid")
  }
  
  if (.datasources$is.datasource.exist(alias)) {
    stop("alias is existed")
  }
  
  if (is.null(engine)) {
    stop("engine must be valid")
  }
  if (!.IsEngineTypeValid(engine)) {
    stop()
  }
  if (engine == "SqlServerPlus") {
    if (is.null(database)) {
      stop("database must be valid")
    }
    if (is.null(driver)) {
      stop("driver must be valid")
    }
  } else if (engine == "OraclePlus") {
    if(is.null(database)){
      stop("database must be valid")
    }
  }
  
  ds <- .iCall("R_Datasource_open", server, driver, database, alias, user, password, engine, PACKAGE="RSuperMap")
  if (is.null(ds) || is.logical(ds)) {
    warning("open datasource failure.")
    return(NULL)
  }
  
  datasets <- .ds.datasets(ds)
  if (is.null(datasets) || !is.list(datasets)) {
    warning("open datasource failure. getting datasets failuer.")
    return(NULL)
  }

  slot(ds, "datasets") <- datasets
  
  .datasources$add.datasource(alias, ds)
  
  return(ds)
}

CreateDatasource <- function(server, alias="", engine="udb", database="", driver="", user="", password=""){
  if (is.null(server)) {
    stop("server must be valid")
  }
  if (!is.character(server)) {
    stop("server  must be character")
  }
  if (is.null(alias)) {
    stop("alias must be valid")
  }
  
  if (.datasources$is.datasource.exist(alias)) {
    stop("alias is existed")
  }
  
  if (is.null(engine)) {
    stop("engine must be valid")
  }
  if (!.IsEngineTypeValid(engine)) {
    stop()
  }
  if (engine == "SqlServerPlus") {
    if (is.null(database)) {
      stop("database must be valid")
    }
    if (is.null(driver)) {
      stop("driver must be valid")
    }
  } else if (engine == "OraclePlus") {
    if(is.null(database)){
      stop("database must be valid")
    }
  }
  
  ds <- .iCall("R_Datasource_create", server, driver, database, 
               alias, user, password, engine, PACKAGE="RSuperMap")
  if (is.null(ds) || is.logical(ds)) {
    warning("create datasource failure.")
    return(NULL)
  }
  .datasources$add.datasource(alias, ds)
  return(ds)
}

CloseDatasource <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  if (class(obj) != "Datasource") {
    stop("obj must be Datasource")
  }
  alias <- GetAlias(obj)
  
  .iCall("R_Datasource_close", obj@pointer, PACKAGE="RSuperMap")
  obj@pointer <- new("externalptr")
  dts <- obj@datasets
  for(dt in dts){
    dt@pointer <- new("externalptr")
  }
  obj@datasets <- list()
  .datasources$remove.datasource(alias)
  return(NULL)
}

GetAlias <- function(obj){
  if(is.null(obj)){
    stop("obj must be valid")
  }
  if(class(obj) != "Datasource"){
    stop("obj must be Datasource")
  }
  res <- .iCall("R_Datasource_alias", obj@pointer, PACKAFE="RSuperMap")
  if(is.null(res) || is.logical(res)){
    warning("getting datasource alias failed")
    return(NULL)
  }
  else{
    return(res)
  }
}

GetDatasets <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  if (class(obj) != "Datasource") {
    stop("obj must be Datasource")
  }
  return(obj@datasets)
}

.dt.name <- function(obj){
  if(is.null(obj)){
    stop("obj must be valid")
  }
  res <- .iCall("R_Dataset_name", obj@pointer, PACKAGE="RSuperMap")
  if(is.null(res) || is.logical(res)){
    warning("getting dataset name failed")
    return(NULL)
  }
  else{
    return(res)
  }
}

setMethod("show", "Datasource", function(object){
  print(object@pointer)
  alias <- GetAlias(object)
  str <- sprintf("alias: %s", alias)
  print(str)
  all.dts <- GetDatasets(object)
  str <- sprintf("dataset count: %d", length(all.dts))
  print(str)
  i <- 1
  for(dt in all.dts){
    name <- GetDatasetName(dt)
    dt.type <- GetDatasetType(dt)
    str <- sprintf("%d: %s: %s", i, name, dt.type)
    i <- i+1
    print(str)
  }
})

setMethod("show", "DatasetVector", function(object){
  print(object@pointer)
  name <- GetDatasetName(object)
  dt.type <- GetDatasetType(object)
  str <- sprintf("%s: %s", name, dt.type)
  print(str)
})

setMethod("show", "DatasetRaster", function(object){
  print(object@pointer)
  name <- GetDatasetName(object)
  dt.type <- GetDatasetType(object)
  str <- sprintf("%s: %s", name, dt.type)
  raster.info <- ReadDatasetRasterInfo(object)
  print(raster.info)
  print(str)
})

setMethod("show", "Dataset", function(object){
  print(object@pointer)
  name <- GetDatasetName(object)
  dt.type <- GetDatasetType(object)
  str <- sprintf("%s: %s", name, dt.type)
  print(str)
})


setGeneric("GetDatasetName", function(obj){
  standardGeneric( "GetDatasetName" )
})

setMethod("GetDatasetName", "Dataset", function(obj){
  .dt.name(obj)
})

setMethod("GetDatasetName", "DatasetVector", function(obj){
  .dt.name(obj)
})

setMethod("GetDatasetName", "DatasetRaster", function(obj){
  .dt.name(obj)
})

DeleteDataset <- function(ds, name){
  if (is.null(ds)) {
    stop("ds must be valid")
  }
  if (class(ds) != "Datasource") {
    stop("ds must be Datasource")
  }
  if (is.null(name)) {
    stop("name must be valid")
  }
  if(!is.character(name)) {
    stop("name must be character")
  }
  if(length(name) == 0){
    stop("name length must be greater 0")
  }
  for(n in name){
    res <- .iCall("R_Datasoruce_Del_Dt", ds@pointer, n, PACKAGE="RSuperMap")
    if(res){
      ds@datasets[[n]] <- NULL
    } else {
      str <- sprintf("delete dataset %s failed", n)
      warning(str)
    }
  }
  .datasources$set.datasource(ds)
  return(ds)
}

GetDataset <- function(obj, name){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  if (class(obj) != "Datasource") {
    stop("obj must be Datasource")
  }
  if (is.null(name)) {
    stop("name must be valid")
  }
  return(obj@datasets[[name]])
}

.dt.type <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  res <- .iCall("R_Dataset_type", obj@pointer, PACKAGE="RSuperMap")
  if(is.null(res) || is.logical(res)){
    warning("getting dataset type failed")
    return(NULL)
  }
  else{
    return(res)
  }
}

setGeneric("GetDatasetType", function(obj){
  standardGeneric( "GetDatasetType" )
})

setMethod("GetDatasetType", "Dataset", function(obj){
  .dt.type(obj)
})

setMethod("GetDatasetType", "DatasetVector", function(obj){
  .dt.type(obj)
})

setMethod("GetDatasetType", "DatasetRaster", function(obj){
  .dt.type(obj)
})

.dt.bounds <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  bounds <- .iCall("R_Dataset_bounds", obj@pointer, PACKAGE="RSuperMap")
  if (is.null(bounds) || is.logical(bounds)) {
    warning("getting dataset bounds failed")
    return(NULL)
  }
  else{
    bbox <- .to.bounds(bounds)
    return(bbox)
  }
}

setGeneric("GetBounds", function(obj){
  standardGeneric( "GetBounds" )
})

setMethod("GetBounds", "Dataset", function(obj){
  .dt.bounds(obj)
})

setMethod("GetBounds", "DatasetVector", function(obj){
  .dt.bounds(obj)
})

setMethod("GetBounds", "DatasetRaster", function(obj){
  .dt.bounds(obj)
})

.dt.open <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  .iCall("R_Dataset_open", obj@pointer, PACKAGE="RSuperMap")
}

setGeneric("OpenDataset", function(obj){
  standardGeneric( "OpenDataset" )
})

setMethod("OpenDataset", "Dataset", function(obj){
  .dt.open(obj)
})

setMethod("OpenDataset", "DatasetVector", function(obj){
  .dt.open(obj)
})

setMethod("OpenDataset", "DatasetRaster", function(obj){
  .dt.open(obj)
})


GetFieldInfos <- function(obj){
  if (is.null(obj)) {
    stop("obj must be valid")
  }
  if (class(obj) != "DatasetVector") {
    stop("obj must be DatasetVector")
  }
  if (!.IsDatasetTypeValid(GetDatasetType(obj))) {
    stop()
  }
  fieldInfos <- .iCall("R_DatasetVector_fieldInfos", obj@pointer, PACKAGE="RSuperMap")
  if (is.null(fieldInfos) || is.logical(fieldInfos)) {
    warning("getting fields info faliuer")
    return(NULL)
  }
  else if (!is.null(fieldInfos) && is.list(fieldInfos)) {
    res <- list()
    for(field in fieldInfos){
      if(!is.null(field) && is.list(field)){
        fieldInfo <- .list2FieldInfo(field)
        res[[fieldInfo@name]] <- fieldInfo
      }
    }
    return(res)
  } else {
    warning("getting fields info faliuer")
    return(NULL)
  }
}

GetAvailableDatasetName <- function(ds, name){
  if (is.null(ds)) {
    stop("datasource must be valid")
  }
  if (class(ds) != "Datasource") {
    stop("ds must be Datasource")
  }
  if (is.null(name)) {
    stop("name must be valid")
  }
  res <- .iCall("R_Datasource_available_name", ds@pointer, name, PACKAGE="RSuperMap")
  if (is.null(res) || is.logical(res)) {
    warning("getting available dataset name failed")
    return(NULL)
  }
  return(res)
}


CreateDatasetVector <- function(ds, name, typeName, fieldInfos=NULL){
  if (is.null(ds)) {
    stop("datasource must be valid")
  }
  if (class(ds) != "Datasource") {
    stop("ds must be Datasource")
  }
  
  if (is.null(name)) {
    stop("name must be valid")
  }
  
  if (is.null(typeName)) {
    stop("dttype must be valid")
  }
  
  if(!.IsDatasetTypeValid(typeName)){
    stop()
  }
  
  fields <- list()
  if (!is.null(fieldInfos)) {
    if (is.vector(fieldInfos)) {
      for(i in c(1:length(fieldInfos))){
        fields[[i]] <- .fieldInfo2List(fieldInfos[[i]])
      }
    }
  }
  avalid.name <- GetAvailableDatasetName(ds, name)
  
  res <- .iCall("R_Datasource_create_dtv", ds@pointer, avalid.name, typeName, fields, PACKAGE="RSuperMap")
  if (is.null(res) || is.logical(res)) {
    warning("creating dataset failed")
    return(NULL)
  }
  dtName = GetDatasetName(res)
  ds@datasets[dtName] <- list(res)
  alias <- GetAlias(ds)
  .datasources$set.datasource(ds)
  
  return(list("datasource"=ds, "datasetVector"=res))
}

.list2FieldInfo <- function(infos){
  if (is.null(infos)) {
    stop("infos must be valid")
  }
  if (!is.list(infos)) {
    stop("infos must be list")
  }
  
  dname <- infos[["name"]]
  dcaption <- character()
  if (!is.null(infos[["caption"]])) {
    dcaption <- infos[["caption"]]
  } else {
    dcaption <- dname
  }
 
  ddefault <- character()
  if (!is.null(infos[["default"]])) {
    ddefault <- infos[["default"]]
  }
  
  dtype <- infos[["type"]]
  
  dsystemField <- FALSE
  if (!is.null(infos[["systemField"]])) {
    dsystemField <- infos[["systemField"]]
  }
  
  drequired <- FALSE
  if (!is.null(infos[["required"]])) {
    drequired <- infos[["required"]]
  }
  
  dmaxLength <- 255L
  if (!is.null(infos[["maxLength"]])) {
    dmaxLength <- as.integer(infos[["maxLength"]])
  }
  
  fieldInfo <- new("FieldInfo", name=dname, caption=dcaption, default = ddefault, 
                   type = dtype, systemField = dsystemField, required = drequired,
                   maxLength = dmaxLength)
  return(fieldInfo)
}

.fieldInfo2List <- function(fieldInfo){
  if (is.null(fieldInfo)) {
    stop("fieldInfo must be valid")
  }
  if (class(fieldInfo) == "FieldInfo") {
    info <- list()
    info[["name"]] <- fieldInfo@name
    info[["type"]] <- fieldInfo@type
    if(length( fieldInfo@caption) == 1){
      info[["caption"]] <- fieldInfo@caption
    } else {
      info[["caption"]] <- character()
    }
    
    if(length( fieldInfo@default) == 1){
      info[["default"]] <- fieldInfo@default
    } else {
      info[["default"]] <- character()
    }
    
    if(length(fieldInfo@maxLength) ==1){
      info[["maxLength"]] <- fieldInfo@maxLength
    } else {
      info[["maxLength"]] <- 255L
    }
    
    info[["systemField"]] <- fieldInfo@systemField
    info[["required"]] <- fieldInfo@required
    return(info)
  } else if (is.list(fieldInfo)) {
    info <- list()
    
    info[["name"]] <- fieldInfo[["name"]]
    info[["type"]] <- fieldInfo[["type"]]
    
    if (!is.null(fieldInfo[["caption"]])) {
      info[["caption"]] <- fieldInfo[["caption"]]
    } else {
      info[["caption"]] <- character()
    }
    
    if (!is.null(fieldInfo[["default"]])) {
      info[["default"]] <- fieldInfo[["default"]]
    } else {
      info[["default"]] <- character()
    }

    if (!is.null(fieldInfo[["systemField"]])) {
      info[["systemField"]] <- fieldInfo[["systemField"]]
    } else {
      info[["systemField"]] <- FALSE
    }
    
    if(!is.null(fieldInfo[["required"]])) {
      info[["required"]] <- fieldInfo[["required"]]
    } else {
      info[["required"]] <- FALSE
    }
    
    if(!is.null(fieldInfo[["maxLength"]])) {
      info[["maxLength"]] <- fieldInfo[["maxLength"]]
    } else {
      info[["maxLength"]] <- 255L
    }
    return(info)
  } else {
    stop("fieldInfo must be FieldInfo object or list")
  }
}

CreateFields <- function(dtv, field.infos){
  if (is.null(dtv)) {
    stop("dtv must be valid")
  }
  if (class(dtv) != "DatasetVector") {
    stop("dtv must be DatasetVector")
  }
  if (!.IsDatasetTypeValid(GetDatasetType(dtv))) {
    stop()
  }
  
  if(!is.vector(field.infos)){
    stop("field.infos must be vector")
  }
  
  fields <- vector(mode="list", length=length(field.infos))
  for(i in c(1:length(field.infos))){
    fields[[i]] <- .fieldInfo2List(field.infos[[i]])
  }
  .iCall("R_DatasetVector_create_fields", dtv@pointer, fields, PACKAGE="RSuperMap")
}

ReadDatasetRasterInfo <- function(dataset){
  if (is.null(dataset)) {
    stop("dataset must be valid")
  }
  if (!is(dataset, "DatasetRaster")) {
    stop("dataset must be DatasetRaster")
  }
  
  res <- .iCall("R_DatasetRaster_Read_RasterInfo", dataset@pointer, PACKAGE="RSuperMap")
  if (is.null(res) || is.logical(res)) {
    warning("Reads dataset raster info failed")
    return(NULL)
  } else {
    result <- list()
    result[["width"]] <- res[[1]]
    result[["height"]] <- res[[2]]
    result[["NoValue"]] <- res[[3]]
    result[["PixelFormat"]] <- res[[4]]
    result[["bounds"]] <- .to.bounds(res[[5]])
    return(result)
  }
}

#' @export
.to.bounds <- function(bounds){
  if(is.null(bounds)){
    return(NULL)
  }
  bbox <- matrix(nrow=2, ncol=2, dimnames=list(c("LT", "RB"), c("x", "y")))

  if(is.list(bounds)){
    bbox[, 1] = c(as.numeric(bounds[[1]]), as.numeric(bounds[[3]]))
    bbox[, 2] = c(as.numeric(bounds[[2]]), as.numeric(bounds[[4]]))
  } else if(is.numeric(bounds) || is.integer(bounds)) {
    bbox[, 1] = c(as.numeric(bounds[1]), as.numeric(bounds[3]))
    bbox[, 2] = c(as.numeric(bounds[2]), as.numeric(bounds[4]))
  }
  else {
    stop("invalid bounds")
  }
  return(bbox)
}


